ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UFailure.inc1.p

Text File | 1990-10-25 | 7.4 KB | 343 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{UFailure.inc1.p}
{Copyright © 1985-1990 Apple Computer, Inc.  All rights reserved.}

{$IFC NOT qDebugTheDebugger}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$ENDC}

VAR
    pWho:                MAName;                         { used serially. Avoids putting it on stack
                                                         }
    {$Push} {$J+}
    {$IFC qDebug}
    GINTENSEDEBUGGING:    Boolean;                        { Since we can't USE UMacApp (2.0) }
    {$EndC}
    {$Pop}

PROCEDURE ApplicationBeep;
    EXTERNAL;

PROCEDURE CatchFailures(VAR fi: FailInfo;
                        PROCEDURE Handler(e: INTEGER;
                                          m: LONGINT));
    EXTERNAL;

PROCEDURE DoFailure(pf: FailInfoPtr);
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE Assertion(condition: Boolean;
                    description: StringPtr);

    BEGIN
    IF NOT condition THEN
        BEGIN
        {$IFC qDebug}
        GetCallersMethodName(pWho);
        IF CanReadLn THEN
            BEGIN
            WriteLn(Concat('Assertion failed in ', pWho, ': ', description^));
            EnterMacAppDebugger;
            IF ReadYesNo(Concat('Do you want to signal failure?')) THEN
                Failure(minErr, 0);                     { ??? silent failure, but someday 0
                                                         messages need to be non-silent }
            END
        ELSE
            BEGIN
            DebugStr(Concat('Assertion failed in ', pWho, ': ', description^));
            Failure(minErr, 0);                         { ??? silent failure, but someday 0
                                                         messages need to be non-silent }
            END;
        {$ELSEC}
        Failure(minErr, 0);                             { ??? silent failure, but someday 0
                                                         messages need to be non-silent }
        {$EndC}
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE EachFailureHandlerDo(PROCEDURE DoToHandler(fiPtr: FailInfoPtr));

    VAR
        pf:                 FailInfoPtr;

    BEGIN
    pf := gTopHandler;

    WHILE (pf <> NIL) DO
        BEGIN
        DoToHandler(pf);
        pf := pf^.nextInfo;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { Call to %_BP could croak the MemError }
{$S MAFailureRes}

PROCEDURE FailMemError;

    VAR
        e:                    OSErr;

    BEGIN
    e := MemError;

    {$IFC qDebug}
    IF gAskFailure & (e = noErr) & CanReadLn THEN
        BEGIN
        GetCallersMethodName(pWho);
        e := ReadInteger(Concat('FailMemError called by ', pWho, '.  Enter return error: '));
        END;
    {$ENDC}

    IF e <> noErr THEN
        Failure(e, 0);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE FailNewMessage(error: INTEGER;
                         oldMessage, newMessage: LONGINT);

    BEGIN
    IF oldMessage = 0 THEN
        oldMessage := newMessage;
    Failure(error, oldMessage);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE FailNIL(p: UNIV Ptr);

    BEGIN
    { no check for gAskFailure here, since we do this when objects are created. }
    IF p = NIL THEN
        Failure(memFullErr, 0);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE FailNILResource(r: UNIV Handle);

    VAR
        e:                    OSErr;

    BEGIN
    {$IFC qDebug}
    IF gAskFailure & (r <> NIL) & CanReadLn THEN
        BEGIN
        GetCallersMethodName(pWho);
        IF ReadYesNo(Concat('FailNilResource called by ', pWho, '.  Return NIL?: ')) THEN
            r := NIL;
        END;
    {$ENDC}

    IF r = NIL THEN
        BEGIN
        e := ResError;
        IF e = noErr THEN
            e := resNotFound;
        Failure(e, 0);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE FailOSErr(error: INTEGER);

    BEGIN
    {$IFC qDebug}
    IF gAskFailure & (error = noErr) & CanReadLn THEN
        BEGIN
        GetCallersMethodName(pWho);
        error := ReadInteger(Concat('FailOSErr called by ', pWho, '.  Enter return error: '));
        END;
    {$ENDC}

    IF error <> noErr THEN
        Failure(error, 0);
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}                     { Call to %_BP could croak the ResError }
{$S MAFailureRes}

PROCEDURE FailResError;

    VAR
        e:                    OSErr;

    BEGIN
    e := ResError;

    {$IFC qDebug}
    IF gAskFailure & (e = noErr) & CanReadLn THEN
        BEGIN
        GetCallersMethodName(pWho);
        e := ReadInteger(Concat('FailResError called by ', pWho, '.  Enter return error: '));
        END;
    {$ENDC}

    IF e <> noErr THEN
        Failure(e, 0);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE Failure(error: INTEGER;
                  message: LONGINT);

    VAR
        pf:                 FailInfoPtr;
        pc:                 LONGINT;

    BEGIN
    pf := gTopHandler;

    IF pf <> NIL THEN
        BEGIN
      {pop the stack first, because calling the handler is likely to
       result in a call to Failure}
        gTopHandler := pf^.nextInfo;

        {$IFC qDebug}
        IF CanWriteLn & ((error <> 0) | GINTENSEDEBUGGING) THEN { only show 0 errors if _really_
                                                                 looking }
            BEGIN
            GetCallersMethodName(pWho);
            WriteLn('Failure signaled by: ', pWho);
            pc := pf^.whoPC;
            GetMethodName(LONGINT(@pc), pWho);

            WriteLn('Failure caught by: ', pWho);
            WriteLn('        error: ', error: 1, ' message: ', message: 1, ' (', BSR(message, 16):
                    1, '/', BAND(message, $0000FFFF): 1, ')');
            END;
        {$ENDC}

        pf^.error := error;
        pf^.message := message;
        DoFailure(pf);                                    {Go execute the failure handler}
        END
    ELSE
        BEGIN
        {$IFC qDebug}
        ProgramBreak('Failure called, but no handler!');
        {$ELSEC}
        DebugStr('Failure called, but no handler!');
        {$ENDC}
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAFailureRes}

PROCEDURE ProgramBreak(grievance: Str255);

    BEGIN
    ApplicationBeep;
    {$IFC qDebug}
    IF CanReadLn THEN
        BEGIN
        DebugForceOutput(forceOn, forceUnchanged);
        WriteLn('ProgramBreak: ', grievance);
        DebugEndForce;
        EnterMacAppDebugger;
        END
    ELSE
        DebugStr(grievance);
    {$ELSEC}
    DebugStr(grievance);
    {$ENDC}
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAFailureRes}

PROCEDURE ProgramReport(grievance: Str255;
                        break: Boolean);

    BEGIN
    ApplicationBeep;
    {$IFC qDebug}
    IF CanReadLn THEN
        BEGIN
        DebugForceOutput(forceOn, forceUnchanged);
        WriteLn('ProgramReport: ', grievance);
        DebugEndForce;
        IF break THEN
            EnterMacAppDebugger;
        END
    ELSE
        DebugStr(grievance);
    {$ELSEC}
    DebugStr(grievance);
    {$ENDC}
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

FUNCTION HandlerExists(testFailInfoPtr: FailInfoPtr): Boolean;

    PROCEDURE DoToHandler(pf: FailInfoPtr);

        BEGIN
        IF pf = testFailInfoPtr THEN
            HandlerExists := true;
        END;

    BEGIN
    HandlerExists := false;
    EachFailureHandlerDo(DoToHandler);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFailureRes}

PROCEDURE Success(VAR fi: FailInfo);

    BEGIN
    {$IFC qDebug}
    IF gTopHandler <> @fi THEN
        BEGIN
        Write('gTopHandler: ');
        WritePtr(gTopHandler);
        Write(', parameter: ');
        WritePtr(@fi);
        WriteLn;
        Write('Problem with Success: ');
        IF HandlerExists(@fi) THEN
            Write('too few ')
        ELSE
            Write('too many ');
        Write('calls to Success');
        WriteLn;
        ProgramBreak('');
        END;
    {$EndC}

    gTopHandler := fi.nextInfo;
    END;